home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / lib / emacs / 19.22 / lisp / mouse-sel.el < prev    next >
Lisp/Scheme  |  1993-11-07  |  15KB  |  438 lines
  1. ;;; mouse-sel.el --- Multi-click selection support for Emacs 19
  2.  
  3. ;; Copyright (C) 1993 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>
  6. ;; Keywords: mouse
  7. ;; Version: $Revision: 1.1 $
  8.  
  9. ;; This file is part of GNU Emacs.
  10.  
  11. ;; GNU Emacs is free software; you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; GNU Emacs is distributed in the hope that it will be useful,
  17. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. ;; GNU General Public License for more details.
  20.  
  21. ;;; Commentary:
  22. ;;
  23. ;; This module provides multi-click mouse support for GNU Emacs versions
  24. ;; 19.18 and later.  I've tried to make it behave more like standard X
  25. ;; clients (eg. xterm) than the default Emacs 19 mouse selection handlers.
  26. ;; Basically:
  27. ;;
  28. ;;   * Clicking mouse-1 starts (cancels) selection, dragging extends it.
  29. ;;
  30. ;;   * Clicking or dragging mouse-3 extends the selection as well.
  31. ;;
  32. ;;   * Double-clicking on word constituents selects words.
  33. ;;     Double-clicking on symbol constituents selects symbols.
  34. ;;     Double-clicking on quotes or parentheses selects sexps.
  35. ;;     Double-clicking on whitespace selects whitespace.
  36. ;;     Triple-clicking selects lines.
  37. ;;
  38. ;;   * Selecting sets the region & X primary selection, but does NOT affect
  39. ;;     the kill-ring.  Because the mouse handlers set the primary selection
  40. ;;     directly, mouse-sel sets the variables interprogram-cut-function
  41. ;;     and interprogram-paste-function to nil.
  42. ;;
  43. ;;   * Clicking mouse-2 pastes contents of primary selection.
  44. ;;
  45. ;;   * Pressing mouse-2 while selecting or extending copies selected text
  46. ;;     to the kill ring.  Pressing mouse-1 or mouse-3 kills it.
  47. ;;
  48. ;; This module requires my thingatpt.el module, version 1.14 or later, which
  49. ;; it uses to find the bounds of words, lines, sexps, etc.
  50. ;;
  51. ;; Thanks to KevinB@bartley.demon.co.uk for his useful input.
  52. ;;
  53. ;;    You may also want to use one or more of following:
  54. ;;
  55. ;;      ;; Enable region highlight
  56. ;;      (transient-mark-mode 1)
  57. ;;
  58. ;;      ;; But only in the selected window
  59. ;;      (setq highlight-nonselected-windows nil)
  60. ;;      
  61. ;;      ;; Enable pending-delete
  62. ;;      (delete-selection-mode 1)
  63. ;;
  64. ;;--- Customisation -------------------------------------------------------
  65. ;;
  66. ;; * You can control the way mouse-sel binds it's keys by setting the value
  67. ;;   of mouse-sel-default-bindings before loading mouse-sel.
  68. ;;
  69. ;;   (a) If mouse-sel-default-bindings = t (the default)
  70. ;;   
  71. ;;       Mouse sets and pastes selection
  72. ;;       mouse-1        mouse-select
  73. ;;       mouse-2        mouse-insert-selection
  74. ;;         mouse-3        mouse-extend
  75. ;;
  76. ;;       Selection/kill-ring interaction is disabled
  77. ;;         interprogram-cut-function   = nil
  78. ;;         interprogram-paste-function = nil
  79. ;;
  80. ;;   (b) If mouse-sel-default-bindings = 'interprogram-cut-paste
  81. ;;   
  82. ;;       Mouse sets selection, and pastes from kill-ring
  83. ;;       mouse-1        mouse-select
  84. ;;       mouse-2        mouse-yank-at-click
  85. ;;       mouse-3        mouse-extend
  86. ;;  
  87. ;;       Selection/kill-ring interaction is retained
  88. ;;         interprogram-cut-function   = x-select-text
  89. ;;         interprogram-paste-function = x-cut-buffer-or-selection-value
  90. ;;         
  91. ;;       What you lose is the ability to select some text in
  92. ;;       delete-selection-mode and yank over the top of it.
  93. ;;       
  94. ;;   (c) If mouse-sel-default-bindings = nil, no bindings are made.
  95. ;;
  96. ;; * I like to leave point at the end of the region nearest to where the
  97. ;;   mouse was, even though this makes region highlighting mis-leading (the
  98. ;;   cursor makes it look like one extra character is selected).  You can
  99. ;;   disable this behaviour with:
  100. ;;
  101. ;;     (setq mouse-sel-leave-point-near-mouse nil)
  102. ;;
  103. ;; * Normally, the selection highlight will be removed when the mouse is
  104. ;;   lifted.  You can tell mouse-sel to retain the selection highlight
  105. ;;   (useful if you don't use transient-mark-mode) with:
  106. ;;
  107. ;;     (setq mouse-sel-retain-highlight t)
  108. ;;
  109. ;; * By default, mouse-select cycles the click count after 3 clicks.  That
  110. ;;   is, clicking mouse-1 four times has the same effect as clicking it
  111. ;;   once, clicking five times has the same effect as clicking twice, etc.
  112. ;;   Disable this behaviour with:
  113. ;;
  114. ;;     (setq mouse-sel-cycle-clicks nil)
  115. ;;
  116. ;; * The variables mouse-sel-{set,get,check}-selection-function control how
  117. ;;   the selection is handled.  Under X Windows, these variables default so
  118. ;;   that the X primary selection is used.  Under other windowing systems,
  119. ;;   alternate functions are used, which simply store the selection value
  120. ;;   in a variable.
  121. ;;
  122. ;;--- Hints ---------------------------------------------------------------
  123. ;;
  124. ;; * You can change the selection highlight face by altering the properties
  125. ;;   of mouse-drag-overlay, eg.
  126. ;;
  127. ;;     (overlay-put mouse-drag-overlay 'face 'bold)
  128. ;;
  129. ;; * Pasting from the primary selection under emacs 19.19 is SLOW (there's
  130. ;;   a two second delay).  The following code will cause mouse-sel to use
  131. ;;   the cut buffer rather than the primary selection.  However, be aware
  132. ;;   that cut buffers are OBSOLETE, and some X applications may not support
  133. ;;   them.
  134. ;;   
  135. ;;     (setq mouse-sel-set-selection-function 'x-select-text
  136. ;;           mouse-sel-get-selection-function 'x-get-cut-buffer)
  137. ;;           
  138. ;;--- Warnings ------------------------------------------------------------
  139. ;;
  140. ;; * When selecting sexps, the selection extends by sexps at the same
  141. ;;   nesting level.  This also means the selection cannot be extended out
  142. ;;   of the enclosing nesting level.  This is INTENTIONAL.
  143.  
  144. ;;; Code:
  145.  
  146. (provide 'mouse-sel)
  147.  
  148. (require 'mouse)
  149. (require 'thingatpt)
  150.  
  151. ;;=== Version =============================================================
  152.  
  153. (defconst mouse-sel-version (substring "$Revision: 1.1 $" 11 -2)
  154.   "The revision number of mouse-sel (as string).  The complete RCS id is:
  155.  
  156.   $Id: mouse-sel.el,v 1.1 1993/11/08 14:27:16 rms Exp $")
  157.  
  158. ;;=== User Variables ======================================================
  159.  
  160. (defvar mouse-sel-leave-point-near-mouse t
  161.   "*Leave point near last mouse position.
  162. If non-nil, \\[mouse-select] and \\[mouse-extend] will leave point at the end
  163. of the region nearest to where the mouse last was.
  164. If nil, point will always be placed at the beginning of the region.")
  165.  
  166. (defvar mouse-sel-retain-highlight nil
  167.   "*Retain highlight on mouse-drag-overlay.
  168. If non-nil, regions selected using \\[mouse-select] and \\[mouse-extend] will
  169. remain highlighted.
  170. If nil, highlighting will be turned off when the mouse is lifted.")
  171.  
  172. (defvar mouse-sel-cycle-clicks t
  173.   "*If non-nil, \\[mouse-select] cycles the click-counts after 3 clicks.
  174. Ie. 4 clicks = 1 click, 5 clicks = 2 clicks, etc.")
  175.  
  176. (defvar mouse-sel-default-bindings t
  177.   "Set to nil before loading mouse-sel to prevent default mouse bindings.")
  178.  
  179. ;;=== Selection ===========================================================
  180.  
  181. (defvar mouse-sel-selection-type nil "Type of current selection")
  182. (make-variable-buffer-local 'mouse-sel-selection-type)
  183.  
  184. (defvar mouse-sel-selection "" 
  185.   "This variable is used to store the selection value when mouse-sel is
  186. used on windowing systems other than X Windows.")
  187.  
  188. (defvar mouse-sel-set-selection-function 
  189.   (if (eq window-system 'x) 
  190.       (function (lambda (s) (x-set-selection 'PRIMARY s)))
  191.     (function (lambda (s) (setq mouse-sel-selection s))))
  192.   "Function to call to set selection.
  193. Called with one argument, the text to select.")
  194.  
  195. (defvar mouse-sel-get-selection-function
  196.   (if (eq window-system 'x) 
  197.       'x-get-selection 
  198.     (function (lambda () mouse-sel-selection)))
  199.   "Function to call to get the selection.
  200. Called with no argument, it should return the selected text.")
  201.  
  202. (defvar mouse-sel-check-selection-function
  203.   (if (eq window-system 'x) 
  204.       'x-selection-owner-p 
  205.     nil)
  206.   "Function to check whether emacs still owns the selection.
  207. Called with no arguments.")
  208.  
  209. (defun mouse-sel-determine-selection-type (NCLICKS)
  210.   "Determine what `thing' \\[mouse-select] and \\[mouse-extend] should
  211. select by.  The first argument is NCLICKS, is the number of consecutive
  212. mouse clicks at the same position."
  213.   (let* ((next-char (char-after (point)))
  214.      (char-syntax (if next-char (char-syntax next-char)))
  215.      (nclicks (if mouse-sel-cycle-clicks (1+ (% (1- NCLICKS) 3)) NCLICKS)))
  216.     (cond
  217.      ((= nclicks 1) nil)
  218.      ((>= nclicks 3) 'line)
  219.      ((memq char-syntax '(?\( ?\) ?\" ?')) 'sexp)
  220.      ((memq next-char '(? ?\t ?\n)) 'whitespace)
  221.      ((eq char-syntax ?_) 'symbol)
  222.      ((eq char-syntax ?w) 'word))))
  223.  
  224. (defun mouse-select (EVENT)
  225.   "Set region/selection using the mouse.
  226.  
  227. On click, point & mark are set to click position, and mark is disabled.
  228. Dragging extends region/selection.
  229.  
  230. Double-clicking on word constituents selects words.
  231. Double-clicking on symbol constituents selects symbols.
  232. Double-clicking on quotes or parentheses selects sexps.
  233. Double-clicking on whitespace selects whitespace.
  234. Triple-clicking selects lines.
  235.  
  236. Clicking mouse-2 while selecting copies the region to the kill-ring.
  237. Clicking mouse-1 or mouse-3 kills the region.
  238.  
  239. This should be bound to a down-mouse event."
  240.   (interactive "e")
  241.   (mouse-set-point EVENT)
  242.   (setq mouse-sel-selection-type
  243.     (mouse-sel-determine-selection-type (event-click-count EVENT)))
  244.   (let ((object-bounds (bounds-of-thing-at-point mouse-sel-selection-type)))
  245.     (if object-bounds
  246.     (progn
  247.       (setq mark-active t)
  248.       (goto-char (car object-bounds))
  249.       (set-mark (cdr object-bounds)))
  250.       (deactivate-mark)))
  251.   (mouse-extend))
  252.  
  253. (defun mouse-extend (&optional EVENT)
  254.   "Extend region/selection using the mouse.
  255.  
  256. See documentation for mouse-select for more details.
  257.  
  258. This should be bound to a down-mouse event."
  259.   (interactive "e")
  260.   (if EVENT (select-window (posn-window (event-end EVENT))))
  261.   (let* ((min (if mark-active (region-beginning) (point)))
  262.      (max (if mark-active (region-end) (point)))
  263.      (orig-window (selected-window))
  264.      (orig-window-frame (window-frame orig-window))
  265.      (top (nth 1 (window-edges orig-window)))
  266.      (bottom (nth 3 (window-edges orig-window)))
  267.      (orig-cursor-type 
  268.       (cdr (assoc 'cursor-type (frame-parameters (selected-frame)))))
  269.      direction
  270.      event)
  271.  
  272.     ;; Inhibit normal region highlight
  273.     (setq mark-active nil)
  274.  
  275.     ;; Highlight region (forcing re-highlight)
  276.     (move-overlay mouse-drag-overlay min max (current-buffer))
  277.     (overlay-put mouse-drag-overlay 'face
  278.          (overlay-get mouse-drag-overlay 'face))
  279.  
  280.     ;; Bar cursor
  281.     (modify-frame-parameters (selected-frame) '((cursor-type . bar)))
  282.  
  283.     ;; Handle dragging
  284.     (unwind-protect
  285.     (progn 
  286.       (track-mouse
  287.         
  288.         (while (if EVENT        ; Use initial event
  289.                (prog1
  290.                (setq event EVENT)
  291.              (setq EVENT nil))
  292.              (setq event (read-event))
  293.              (and (consp event)
  294.               (memq (car event) '(mouse-movement switch-frame))))
  295.           
  296.           (let ((end (event-end event)))
  297.             
  298.         (cond
  299.              
  300.          ;; Ignore any movement outside the frame
  301.          ((eq (car-safe event) 'switch-frame) nil)
  302.          ((and (posn-window end)
  303.                (not (eq (window-frame (posn-window end))
  304.                 (window-frame orig-window)))) nil)
  305.              
  306.          ;; Different window, same frame
  307.          ((not (eq (posn-window end) orig-window))
  308.           (let ((end-row (cdr (cdr (mouse-position)))))
  309.             (cond
  310.              ((and end-row (not (bobp)) (< end-row top))
  311.               (mouse-scroll-subr (- end-row top)
  312.                      mouse-drag-overlay max))
  313.              ((and end-row (not (eobp)) (>= end-row bottom))
  314.               (mouse-scroll-subr (1+ (- end-row bottom))
  315.                      mouse-drag-overlay min))
  316.              )))
  317.  
  318.          ;; On the mode line
  319.          ((eq (posn-point end) 'mode-line)
  320.           (mouse-scroll-subr 1 mouse-drag-overlay min))
  321.  
  322.          ;; In original window
  323.          (t (goto-char (posn-point end)))
  324.  
  325.          )
  326.  
  327.         ;; Determine direction of drag
  328.         (cond
  329.          ((and (not direction) (not (eq min max)))
  330.           (setq direction (if (< (point) (/ (+ min max) 2)) -1 1)))
  331.          ((and (not (eq direction -1)) (<= (point) min))
  332.           (setq direction -1))
  333.          ((and (not (eq direction 1)) (>= (point) max))
  334.           (setq direction 1)))
  335.         
  336.         (if (not mouse-sel-selection-type) nil
  337.           
  338.           ;; If dragging forward, goal is next character
  339.           (if (and (eq direction 1) (not (eobp))) (forward-char 1))
  340.           
  341.           ;; Move to start/end of selected thing
  342.           (let ((goal (point))
  343.             last)
  344.             (goto-char (if (eq 1 direction) min max))
  345.             (condition-case nil
  346.             (progn
  347.               (while (> (* direction (- goal (point))) 0)
  348.                 (setq last (point))
  349.                 (forward-thing mouse-sel-selection-type 
  350.                        direction))
  351.               (let ((end (point)))
  352.                 (forward-thing mouse-sel-selection-type
  353.                        (- direction))
  354.                 (goto-char
  355.                  (if (> (* direction (- goal (point))) 0)
  356.                  end last))))
  357.               (error))))
  358.         
  359.         ;; Move overlay
  360.         (move-overlay mouse-drag-overlay
  361.                   (if (eq 1 direction) min (point))
  362.                   (if (eq -1 direction) max (point))
  363.                   (current-buffer))
  364.           
  365.         )))            ; end track-mouse
  366.  
  367.       (let ((overlay-start (overlay-start mouse-drag-overlay))
  368.         (overlay-end (overlay-end mouse-drag-overlay)))
  369.  
  370.         ;; Set region
  371.         (if (eq overlay-start overlay-end)
  372.         (deactivate-mark)
  373.           (if (and mouse-sel-leave-point-near-mouse (eq direction 1))
  374.           (progn
  375.             (set-mark overlay-start)
  376.             (goto-char overlay-end))
  377.         (set-mark overlay-end)
  378.         (goto-char overlay-start)))
  379.         
  380.         ;; Set selection
  381.         (if (and mark-active mouse-sel-set-selection-function)
  382.         (funcall mouse-sel-set-selection-function 
  383.              (buffer-substring overlay-start overlay-end)))
  384.           
  385.         ;; Handle copy/kill
  386.         (cond
  387.          ((eq (car-safe last-input-event) 'down-mouse-2)
  388.           (copy-region-as-kill overlay-start overlay-end)
  389.           (read-event) (read-event))
  390.          ((memq (car-safe last-input-event) '(down-mouse-1 down-mouse-3))
  391.           (kill-region overlay-start overlay-end)
  392.           (deactivate-mark)
  393.           (read-event) (read-event)))))
  394.  
  395.       ;; Restore cursor
  396.       (modify-frame-parameters (selected-frame) 
  397.                    (list (cons 'cursor-type orig-cursor-type)))
  398.       ;; Remove overlay
  399.       (or mouse-sel-retain-highlight
  400.       (delete-overlay mouse-drag-overlay)))))
  401.  
  402. (defun mouse-insert-selection (click)
  403.   "Insert the contents of the selection at mouse click."
  404.   (interactive "e")
  405.   (mouse-set-point click)
  406.   (deactivate-mark)
  407.   (if mouse-sel-get-selection-function
  408.       (insert (or (funcall mouse-sel-get-selection-function) ""))))
  409.  
  410. (defun mouse-sel-validate-selection ()
  411.   "Remove selection highlight if emacs no longer owns the primary selection."
  412.   (or (not mouse-sel-check-selection-function)
  413.       (funcall mouse-sel-check-selection-function)
  414.       (delete-overlay mouse-drag-overlay)))
  415.  
  416. (add-hook 'pre-command-hook 'mouse-sel-validate-selection)
  417.  
  418. ;;=== Key bindings ========================================================
  419.  
  420. (if (not mouse-sel-default-bindings) nil
  421.   
  422.   (global-unset-key [mouse-1])
  423.   (global-unset-key [drag-mouse-1])
  424.   (global-unset-key [mouse-3])
  425.   
  426.   (global-set-key [down-mouse-1]    'mouse-select)
  427.   (global-set-key [down-mouse-3]     'mouse-extend)
  428.   
  429.   (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) nil
  430.     
  431.     (global-set-key [mouse-2]     'mouse-insert-selection)
  432.     (setq interprogram-cut-function nil
  433.       interprogram-paste-function nil))
  434.   
  435.   )
  436.  
  437. ;; mouse-sel.el ends here.
  438.